COMMENT ⊗   VALID 00015 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE ARPSER
C00005 00003	CORBEG NETCMP RCBINP TRBINP ECHOP SUPGAP PUPIBH PUPOBH GOTINT FLSCHP PDL HSTBUF COREND LSNBLK SMRBLK RMRBLK INPBLK
C00007 00004	CODE TPLTAB TPLMIN WDOTAB WDOMAX EXOPL NIORTS HSTTAB INTBTS
C00011 00005	 ARPSER NWLOTS ISLOTS INTRPT
C00014 00006	GETHST GETDIG GETSKT GETSK1
C00016 00007	GETHSN GETHN1 GETHN2
C00018 00008	GOTHST
C00020 00009	LOOP NETSER NETSR1 PUPSER PUPSR1 PUPSR2 PUPSR3
C00023 00010	IACSER PRSTAB
C00025 00011	DOSR DONTSR
C00027 00012	WILLSR WONTSR
C00029 00013	OPTMSG RNDMSG
C00030 00014	PUPICW PUPICH PUPIC1 PUPIC2 PUPIC3 PUPIC4
C00033 00015	PUPOCH SNDMSG MSGLUP PUPSND NETERR REJECT SUICID ...LIT
C00035 ENDMK
C⊗;
TITLE ARPSER
SUBTTL Mark Crispin, SU-AI, October 1981

; Assembly switches

IFNDEF SVRSKT,<SVRSKT←←131>	; default listen socket
IFNDEF NPRSKT,<NPRSKT←←27>	; new TELNET protocol socket
IFNDEF LOKTMO,<LOKTMO←←5>	; # of 15-second frobs of lock timeout
IFNDEF PDLLEN,<PDLLEN←←50>	; stack length
IFNDEF HSTBFL,<HSTBFL←←=10>	; host name buffer length
IFNDEF FTPUPBUG,<FTPUPBUG←←-1>

; AC definitions.  0→3 are used by NETWRK

X←11 ↔ Y←12 ↔ A←13 ↔ B←14 ↔ C←15 ↔ P←17

PUP←←2				; Pup's I/O channel (NETWRK uses 0 and 1)

; Macro to send a TELNET command

DEFINE TELCMD' (CMDLST) <
 OUTSTR [ASCIZ/⊗'CMDLST'*
/]
 FOR CMD IN (CMDLST) <
  MOVEI CMD
  PUSHJ P,NETOCH
   JRST SUICID
 >;FOR
 PUSHJ P,NETSND
  JRST SUICID
>;DEFINE TELCMD
;CORBEG NETCMP RCBINP TRBINP ECHOP SUPGAP PUPIBH PUPOBH GOTINT FLSCHP PDL HSTBUF COREND LSNBLK SMRBLK RMRBLK INPBLK

CORBEG←←.			; start of initialized storage

; Protocol flags

NETCMP:	BLOCK 1			; -1 → IAC in progress

FOR @' OPT IN (WILL,WONT,DO,DONT) <
 OPT'P:	BLOCK 1			; -1 → option in effect
>;FOR

RCBINP:	BLOCK 1			; -1 → receiving binary
TRBINP:	BLOCK 1			; -1 → transmitting binary
ECHOP:	BLOCK 1			; -1 → remote echoing
SUPGAP:	BLOCK 1			; -1 → suppressing GA
FLSCHP:	BLOCK 1			; -1 → ignore next byte

; Other storage

PUPIBH:	BLOCK 3			; Pup input buffer header
PUPOBH:	BLOCK 3			; Pup output buffer header
GOTINT:	BLOCK 1			; -1 → got an interrupt
PDL:	BLOCK PDLLEN		; stack

HSTBUF:	BLOCK HSTBFL		; host string buffer

COREND←←.-1			; end of initialized storage

LSNBLK:	1			;Opcode = LISTEN
LSNSTS:	0			;Status
	131			;Local socket (GENSYM)
	-1			;Wait for connection
	8			;Bytesize (checked, but not used by PUP)
	-1			;Foreign socket
	0			;Host number

SMRBLK:	25			; send Mark
	0			; status word
	6			; Timing Mark Reply

RMRBLK:	26			; read last Mark
	0			; status word
	0			; Mark type returned here

INPBLK:	10			; skip if input available
	0			; status word

;CODE TPLTAB TPLMIN WDOTAB WDOMAX EXOPL NIORTS HSTTAB INTBTS

DEFINE TPC (CODE,VALUE) <
 CODE←←VALUE
 [ASCIZ/CODE/]
>;TERMIN

; Protocol codes

TPLTAB:
 TPC (SE,360)			; subnegotiation end
 TPC (NOP,361)			; no-op
 TPC (DM,362)			; data mark
 TPC (BRK,363)			; break key
 TPC (IP,364)			; interrupt process
 TPC (AO,365)			; abort output
 TPC (AYT,366)			; are you there?
 TPC (EC,367)			; erase character
 TPC (EL,370)			; erase line
 TPC (GA,371)			; go ahead
 TPC (SB,372)			; subnegotiation
 TPC (WILL,373)			; sender will do
 TPC (WONT,374)			; sender won't do
 TPC (DO,375)			; receiver asked to do
 TPC (DONT,376)			; receiver must not do
 TPC (IAC,377)			; interpret as command
TPLMIN←←<400-<.-TPLTAB>>

; WILL/WONT/DO/DONT codes

WDOTAB:
 TPC (TRNBIN,0)			; transmit binary
 TPC (ECHO,1)			; echo
 TPC (RCP,2)			; reconnect
 TPC (SUPRGA,3)			; suppress GA
 TPC (NAMS,4)			; negotiate approx. message size
 TPC (STATUS,5)			; status option
 TPC (TIMMRK,6)			; timing mark
 TPC (RCTE,7)			; remote controlled trans/echo
 TPC (NAOL,10)			; negotiate output line width
 TPC (NAOP,11)			; negotiate page size
 TPC (NAOCRD,12)		; negotiate output CR
 TPC (NAOHTS,13)		; negotiate output horizontal tab stops
 TPC (NAOHTD,14)		; negotiate output HT
 TPC (NAOFFD,15)		; negotiate output FF
 TPC (NAOVTS,16)		; negotiate output vertical tab stops
 TPC (NAOVTD,17)		; negotiate output VT
 TPC (NAOLFD,20)		; negotiate output LF
 TPC (EXTASC,21)		; Tovar's cretinous idea of extended ASCII
 TPC (LOGOUT,22)		; logout option
 TPC (BM,23)			; byte macro
 TPC (DET,24)			; data entry terminal option
 TPC (SUPDUP,25)		; SUPDUP (not TELNET) protocol
 TPC (SDOTPT,26)		; SUPDUP output option
WDOMAX←←<.-WDOTAB-1>

EXOPL←←377			; extended options (great idea Postel)

; Wonderful network routines

NIORTS←←-1			; network I/O routines for a user program
HSTTAB←←-1			; include host table magic

.INSERT NETWRK.FAI[SUB,SYS]

INTBTS←←<INTINP!INTIMS>

repeat 0,<
CLKTIM←←=60*=60			; time between clock ints (some seconds)
IDLECT:	0			; count of times through main loop while idle
WORKED:	-1			; nonzero if did work this time around main loop
MAXIDL←←3			; idle count at which we go away if no job
>;repeat 0
;⊗ ARPSER NWLOTS ISLOTS INTRPT

ARPSER:	TRN
	RESET
	MOVE ['ARPSER']		; set our name
	SETNAM
	SETZM CORBEG		; initialize core
	MOVE [CORBEG,,CORBEG+1]
	BLT COREND
	MOVE P,[IOWD PDLLEN,PDL]
	OUTSTR [ASCIZ/ARPSER started
/]
	INIT PUP,
	 SIXBIT/PUP/
	 PUPOBH,,PUPIBH
	 EXIT
	MOVEI =8		; change byte size in buffer header
	DPB [300600,,PUPIBH+1]
	DPB [300600,,PUPOBH+1]
	INBUF PUP,
	OUTPUT PUP,		; for some reason OUTBUF loses, or did in CHTSER
	SETSTS PUP,		; kill IOIMPM set by previous OUTPUT
	MTAPE PUP,LSNBLK	; open up the connection
	MOVE LSNSTS		; check for MTAPE error
	STATO PUP,467600
	TRNE 77
	 EXIT
	MOVEI 0,INTRPT		; interrupt routine's address
	MOVEM 0,JOBAPR↑		; set up server location
;	CLKINT CLKTIM		; clock ints are used for idle timeout check
	MOVSI 0,(INTBTS)
	INTENB 0,		; turn on interrupts
	LDB 0,[POINT 8,LSNBLK+6,27] ; get foreign PUP host's subnet number
NWLOTS←←60	;LOTS subnet number
	CAIN 0,NWLOTS		; if LOTS, we'll reject the connection
	JRST ISLOTS		; yup, don't provide ARPA access
;matching bracket <
	MOVEI X,[ASCIZ/SU-AI SUnet => ARPANET Gateway Version 1.0
/]
	PUSHJ P,SNDMSG
	JRST GETHST

ISLOTS:	MOVEI X,[ASCIZ/Requested service declined
/]
;;	PUSHJ P,SNDMSG	;; use this if you want to give friendly declination
	EXIT

INTRPT:	SETOM GOTINT	; flag an interrupt
	SKIPL 6		; skip if RUN bit on in JBTSTS (from AC 6)
	DISMIS		; don't requeue to TQ if job isn't runnable!
	MOVE X,JOBCNI↑
	TLNE X,(INTINR)
	 OUTSTR [ASCIZ/*INR*
/]
	TLNE X,(INTINS)	; INS int
	 OUTSTR [ASCIZ/*INS*
/]
	MOVSI 1,-1	; requeue into TQ from any queue
	DISMIS 1,]
;GETHST GETDIG GETSKT GETSK1

; Get host name or number

GETHST:	MOVEI B,NPRSKT		; default socket number
	PUSHJ P,PUPICW		; get first character
	CAIL "0"		; numeric?
	 CAILE "7"
	  JRST GETHSN		; no, must be name
	SETZ A,
GETDIG:	SUBI "0"
	ADD A,
	PUSHJ P,PUPICW
	CAIN "."		; socket delimiter?
	 JRST GETSKT
	CAIN " "
	 JRST GOTHST
	CAIL "0"
	 CAILE "7"
	  JRST [MOVEI X,[ASCIZ/-Invalid host number
/]
		JRST REJECT]
	LSH A,3			; have another host digit
	JRST GETDIG

GETSKT:	SETZ B,
GETSK1:	PUSHJ P,PUPICW
	CAIE "M"-100
	 CAIN " "
	  JRST GOTHST
	CAIL "0"
	 CAILE "7"
	  JRST [MOVEI X,[ASCIZ/-Invalid socket number
/]
		JRST REJECT]
	LSH B,3			; have another socket digit
	SUBI "0"
	ADD B,
	JRST GETSK1
;GETHSN GETHN1 GETHN2

GETHSN:	DMOVE X,[POINT 7,HSTBUF
		 5*HSTBFL]
GETHN1:	IDPB X
	PUSHJ P,PUPICW		; get next character
	CAIN "M"-100		; allow CR too
	 JRST GETHN2
	CAIE "."		; socket delimiter?
	 CAIN " "		; terminating space?
	  JRST GETHN2
	SOJG Y,GETHN1		; insert character in buffer
	MOVEI X,[ASCIZ/-Host name too long
/]
	JRST REJECT

GETHN2:	MOVE C,			; save delimiter character
	PUSHJ P,MAPHST		; map in host table
	MOVEI HSTBUF
	PUSHJ P,HSTNAM
	 JRST [	MOVEI X,[ASCIZ/-No such host name
/]
		JRST REJECT]
	 JRST [	MOVEI X,[ASCIZ/-Ambiguous host name
/]
		JRST REJECT]
	MOVE A,
	PUSHJ P,UNMHST		; unmap host table
	CAIN C,"."		; have socket?
	 JRST GETSKT
;	JRST GOTHST
;GOTHST

GOTHST:	MOVEM A,HOST
	MOVEM B,ICPSKT
	PUSHJ P,CONECT
	 JRST [	TRNE 77		; UUO lossage?
		 JRST NETERR
		TLNN (CLSR)
		 SKIPA X,[ASCIZ/-Time out
/]
		  MOVEI X,[ASCIZ/-Refused
/]
		JRST REJECT]
	 JRST [	TRNN RSET!TMO!IODEND!IOIMPM!HDEAD
		 JRST NETERR
		TRNE RSET
		 MOVEI X,[ASCIZ/-Host reset
/]
		TRNE TMO
		 MOVEI X,[ASCIZ/-Time out
/]
		TRNE IODEND!IOIMPM
		 MOVEI X,[ASCIZ/-Host closed connection
/]
		TRNE HDEAD
		 MOVEI X,[ASCIZ/-Host dead
/]
		JRST REJECT]
	MOVEI X,[ASCIZ/+/]
	PUSHJ P,SNDMSG

; Send ARPANET protocol commands and enter main loop

	LOCK			; lock us in core
	CAIE B,NPRSKT
	 JRST LOOP		; no, don't bother with initial commands
	TELCMD <IAC,DO,ECHO,IAC,DO,SUPRGA>
	SETOM ECHOP
	SETOM SUPGAP
;	JRST LOOP
;LOOP NETSER NETSR1 PUPSER PUPSR1 PUPSR2 PUPSR3

; Main program loop

LOOP:	SKIPN GOTINT		; got an interrupt?
	 IMSTW [INTBTS]		; wait for one to happen
	INTMSK [0]		; mask off interrupts
	SETZM GOTINT
	MOVEI 2			; check connection status
	MTAPE NET,
	TLNN 1,(CLSS!CLSR)	; send side gronked?
	 TLNE 2,(CLSS!CLSR)	; receive side?
	  JRST SUICID
;	JRST NETSER

; ARPANET server

NETSER:	PUSHJ P,NETICH		; get character from ARPANET
	 JRST SUICID		; I/O error
	 JRST PUPSER		; ARPANET input buffer empty
	AOSG NETCMP		; IAC in progress?
	 JRST IACSER
	FOR @' OPT IN (WILL,WONT,DO,DONT) <
	 AOSG OPT'P
	  JRST OPT'SR
	>;FOR
	CAIN IAC		; network command?
	 JRST [	SETOM NETCMP	; remember that one is coming
		JRST NETSER]
NETSR1:	PUSHJ P,PUPOCH
	JRST NETSER		; try for more user characters

; Pup server

PUPSER:	PUSHJ P,PUPSND		; force the buffer out
PUPSR1:	PUSHJ P,PUPICH
	 JRST [	PUSHJ P,NETSND	; send the buffer out
		 JRST SUICID
		STATZ PUP,IODEND
		 JRST SUICID
		JRST LOOP]
	CAIE "M"-100		; CR?
	 JRST PUPSR2
	PUSHJ P,NETOCH
	 JRST SUICID
	SKIPE TRBINP
	 TDZA			; transmitting binary, send NUL
	  MOVEI "J"-100		; no binary, send LF
PUPSR2:	CAIE IAC		; sending edit-rubout?
	 JRST PUPSR3
	PUSHJ P,NETOCH		; yes, double it
	 JRST SUICID
	MOVEI IAC
PUPSR3:	PUSHJ P,NETOCH		; send it to the network
	 JRST SUICID
	JRST PUPSR1
;IACSER PRSTAB

; IAC server

IACSER:	OUTSTR [ASCIZ/*IAC /]
	CAIGE TPLMIN		; big enough?
	 JRST [	PUSHJ P,RNDMSG	; unknown, flush
		JRST NETSER]
	MOVE 1,
	OUTSTR @TPLTAB-TPLMIN(1)
	CAIE IAC
	 CAIGE WILL
	  OUTSTR [ASCIZ/*
/]
	XCT PRSTAB-TPLMIN(1)
	JRST NETSER

DEFINE NC (CODE,SERVER) <
 IFN <.+TPLMIN-PRSTAB-CODE>,<.FATAL Lossage at CODE>
 SERVER
>;DEFINE NC

PRSTAB:				; Protocol command server table

NC SE,<JRST NETSER>
NC NOP,<JRST NETSER>
NC DM,<JRST NETSER>
NC BRK,<JRST NETSER>
NC IP,<JRST NETSER>
NC AO,<JRST NETSER>
NC AYT,<JRST NETSER>
NC EC,<JRST NETSER>
NC EL,<JRST NETSER>
NC GA,<JRST NETSER>
NC SB,<JRST NETSER>
NC WILL,<SETOM WILLP>
NC WONT,<SETOM WONTP>
NC DO,<SETOM DOP>
NC DONT,<SETOM DONTP>
NC IAC,<JRST NETSR1>
;DOSR DONTSR

; IAC DO/DONT

DOSR:	PUSHJ P,OPTMSG
	CAIN TRNBIN		; binary from host
	 JRST [	SKIPE TRBINP	; catch protocol loops
		 JRST NETSER
		SETOM TRBINP
		TELCMD <IAC,WILL,TRNBIN>
		JRST NETSER]
	CAIN TIMMRK		; silly Timing Mark?
	 JRST [	TELCMD <IAC,WILL,TIMMRK>
		JRST NETSER]

; Not an option we like, refuse it

	PUSH P,
	OUTSTR [ASCIZ/⊗IAC WONT/]
	MOVEI IAC
	PUSHJ P,NETOCH
	 JRST SUICID
	MOVEI WONT
	PUSHJ P,NETOCH
	 JRST SUICID
	POP P,
	PUSHJ P,OPTMSG
	PUSHJ P,NETOCH
	 JRST SUICID
	PUSHJ P,NETSND
	 JRST SUICID
	JRST NETSER

DONTSR:	PUSHJ P,OPTMSG
	CAIN TRNBIN
	 SKIPN TRBINP
	  JRST NETSER
	SETZM TRBINP
	TELCMD <IAC,WONT,TRNBIN>
	JRST NETSER
;WILLSR WONTSR

; IAC WILL/WONT

WILLSR:	PUSHJ P,OPTMSG
	CAIN TRNBIN		; binary to host
	 JRST [	SKIPE RCBINP	; catch protocol loops
		 JRST NETSER
		SETOM RCBINP
		TELCMD <IAC,DO,TRNBIN>
		JRST NETSER]
	CAIN ECHO		; remote echo (what a win!)
	 JRST [	SKIPE ECHOP	; catch protocol loops
		 JRST NETSER
		SETOM ECHOP
		TELCMD <IAC,DO,ECHO>
		JRST NETSER]	; command, we always accept it
	CAIN SUPRGA		; suppress GA?
	 JRST [	SKIPE SUPGAP	; command or reply?
		 JRST NETSER
		SETOM SUPGAP
		TELCMD <IAC,DO,SUPRGA>
		JRST NETSER]

; Not an option we like, refuse it

	PUSH P,
	OUTSTR [ASCIZ/⊗IAC DONT/]
	MOVEI IAC
	PUSHJ P,NETOCH
	 JRST SUICID
	MOVEI DONT
	PUSHJ P,NETOCH
	 JRST SUICID
	POP P,
	PUSHJ P,OPTMSG
	PUSHJ P,NETOCH
	 JRST SUICID
	PUSHJ P,NETSND
	 JRST SUICID
	JRST NETSER

WONTSR:	PUSHJ P,OPTMSG
	CAIN TRNBIN
	 JRST [	SKIPN RCBINP
		 JRST NETSER
		SETZM RCBINP
		TELCMD <IAC,DONT,TRNBIN>
		JRST NETSER]
	CAIN ECHO
	 JRST [	SKIPN ECHOP
		 JRST NETSER
		SETZM ECHOP	; back to lossage
		TELCMD <IAC,DONT,ECHO>
		JRST NETSER]
	CAIN SUPRGA
	 SKIPL SUPGAP
	  JRST NETSER		; protocol violator
	SETZM SUPGAP
	TELCMD <IAC,DONT,SUPRGA>
	JRST NETSER
;OPTMSG RNDMSG

; WILL/WONT/DO/DONT option message

OPTMSG:	CAIN EXOPL
	 JRST [	OUTSTR [ASCIZ/ EXOPL*
/]
		POPJ P,]
	OUTCHR [" "]
	CAILE WDOMAX
	 JRST RNDMSG
	MOVE 1,
	OUTSTR @WDOTAB(1)
	OUTSTR [ASCIZ/*
/]
	POPJ P,

RNDMSG:	IDIVI 100	; output the octal for an unknown message
	ADDI "0"
	OUTCHR
	IDIVI 10
	ADDI 1,"0"
	OUTCHR 1
	ADDI 2,"0"
	OUTCHR 2
	OUTSTR [ASCIZ/*
/]
	POPJ P,
;PUPICW PUPICH PUPIC1 PUPIC2 PUPIC3 PUPIC4

; Get character from Ethernet

PUPICW:	TDZA 2,2
PUPICH:	 SETO 2,
PUPIC1:	SOSLE PUPIBH+2		; data available?
	 JRST PUPIC4
	JUMPE 2,PUPIC2
	HRRZ 1,PUPIBH
	HRRZ 1,(1)
	SKIPGE (1)		; anything in further buffers?
	 JRST PUPIC2
	MTAPE PUP,INPBLK	; no - new packet available?
	 POPJ P,
PUPIC2:	IN PUP,			; yes - get it
	 JRST PUPIC3
	GETSTS PUP,1
	TRZN 1,IODEND!IODTER	; End seen?
	 TRZN 1,IOBKTL		; Mark seen?
	  JRST SUICID
	SETSTS PUP,(1)		; yes, clear error status
	MTAPE PUP,RMRBLK
	 TRN
	MOVE RMRBLK+2		; get Mark type
	CAIN 5			; Timing Mark?
	 JRST [	MTAPE PUP,SMRBLK; yes, send Timing Mark Reply
		 JRST SUICID
		JRST PUPIC1]
	CAIL 2			; between Line Width
	 CAILE 4		; and Terminal Type?
	  JRST PUPIC1		; no
	SETOM FLSCHP		; yes, ignore next byte
	JRST PUPIC1

PUPIC3:	MOVE 1,PUPIBH		;Get address of buffer
	ADD 1,1(1)		;Address last word in buffer
	LDB 1,[POINT 4,1(1),35]	;Get padding information
	SKIPG 1,[0↔-1↔2↔-2↔4↔5↔6↔-3↔10↔11↔12↔13↔14↔15↔16↔17](1)
				;Should NEVER skip
	  ADDB 1,PUPIBH+2	;Update byte count
PUPIC4:	ILDB PUPIBH+1		; get the byte
	AOSN FLSCHP		; ignore this byte?
	 JRST PUPIC1		; yes, get next
	SKIPE 2
	 AOS (P)
	POPJ P,
;PUPOCH SNDMSG MSGLUP PUPSND NETERR REJECT SUICID ...LIT

; Send character to Ethernet

PUPOCH:	SOSG PUPOBH+2
	 PUSHJ P,PUPSND
	IDPB PUPOBH+1
IFN FTPUPBUG,<
	MOVE 1,PUPOBH+2
	CAIG 1,600
	 PUSHJ P,PUPSND
>;IFN FTPUPBUG
	POPJ P,

; Send a message, s.p. in X

SNDMSG:	TLOA X,440700		; set up b.p.
MSGLUP:	 PUSHJ P,PUPOCH
	ILDB X
	JUMPN MSGLUP		; continue until a null hit
PUPSND:	MOVE A,PUPOBH+2
	ANDI A,3
	MOVE A,[0
		1
		3
		7](A)
	SKIPLE PUPOBH		; set fill bits only if buffers are setup properly
	DPB A,[	POINT 4,@PUPOBH+1,35 ]
	OUT PUP,
	 POPJ P,
	OUTSTR [ASCIZ/Pup output error/]
	STATZ PUP,IODTER
	 OUTSTR [ASCIZ/ - timeout/]
	JRST SUICID		; connection died

; "Impossible network errors"

NETERR:	MOVEI X,[ASCIZ/-ARPANET lossage, try again
/]

; General network errors

REJECT:	PUSHJ P,SNDMSG
	MOVEI 2
	SLEEP
	CLOSE PUP,
;	JRST SUICID

; Here to suicide on network errors

SUICID:	RELEASE PUP,
	RELEASE NET,
	RESET
	EXIT

...LIT:	LIT

END ARPSER